home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / INTRFC61.ARJ / PARAMS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-11  |  3KB  |  112 lines
  1.  
  2. unit params;
  3. interface
  4.   uses dos,globals,util;
  5.  
  6.   procedure syntax_exit(msg:string);
  7.   procedure parse_params;
  8.  
  9. implementation
  10.  
  11. procedure syntax_exit(msg:string);
  12. begin
  13.   writeln(msg);
  14.   writeln('Syntax:');
  15.   writeln('INTRFC /options unit');
  16.   writeln('where options are letters from the following:');
  17.   writeln('B - emitted code bytes');
  18.   writeln('C - initialized constant blocks');
  19.   writeln('D - code blocks');
  20.   writeln('E - routine entry records');
  21.   writeln('G - emitted global const bytes');
  22.   writeln('H - TPU header');
  23.   writeln('I - implementation section (if $D was used in compilation)');
  24.   writeln('L - proc/fn locals (if $L was used in compilation)');
  25.   writeln('M - source line number map');
  26.   writeln('N - names in interface');
  27.   writeln('O - object VMT records');
  28.   writeln('R - relocation records');
  29.   writeln('S - source file records');
  30.   writeln('V - var blocks');
  31.   writeln('X - mystery section (default on)');
  32.   writeln('A - turn all options on');
  33.   writeln('Options are processed sequentially and toggle the display.');
  34.   writeln('Use /Tpath to set the Turbo directory for TURBO.TPL and referenced');
  35.   writeln(' units.');
  36.   writeln('E.G. To see all but the relocation records in the system unit, use');
  37.   writeln('   INTRFC /AR /T\turbo SYSTEM ');
  38.   writeln('The default is just the names in the interface section.');
  39.   halt(1);
  40. end;
  41.  
  42. procedure toggle(o:option);
  43. begin
  44.   if o in active_options then
  45.     active_options := active_options - [o]
  46.   else
  47.     active_options := active_options + [o];
  48. end;
  49.  
  50. procedure parse_params;
  51. var
  52.   p : string;
  53.   i : integer;
  54.   path : dirstr;
  55.   name : namestr;
  56.   ext : extstr;
  57.  
  58. begin
  59.   i := 1;
  60.   unitname := '';
  61.   uses_path := '';
  62.   for i := 1 to paramcount do
  63.   begin
  64.     p := paramstr(i);
  65.     if p[1] <> '/' then
  66.     begin
  67.       unitname := upper(p);
  68.       fsplit(unitname,path,name,ext);
  69.       unitname := path+name;
  70.     end
  71.     else
  72.     begin
  73.       p := copy(p,2,255);   { strip off the / }
  74.       while length(p) > 0 do
  75.       begin
  76.         case upcase(p[1]) of
  77.         'A' : active_options := [do_header..do_locals];
  78.         'B' : toggle(do_code);
  79.         'C' : toggle(do_const_blocks);
  80.         'D' : toggle(do_code_blocks);
  81.         'E' : toggle(do_entry_pts);
  82.         'G' : toggle(do_const);
  83.         'H' : toggle(do_header);
  84.         'I' : toggle(do_implementation);
  85.         'L' : toggle(do_locals);
  86.         'M' : toggle(do_src_lines);
  87.         'N' : toggle(do_name_list);
  88.         'O' : toggle(do_vmt);
  89.         'R' : toggle(do_reloc);
  90.         'S' : toggle(do_src_files);
  91.         'U' : toggle(do_unit_blocks);
  92.         'V' : toggle(do_var_blocks);
  93.         'X' : toggle(do_mystery);
  94.         'T' : begin
  95.                 uses_path := copy(p,2,255);
  96.                 if uses_path[length(uses_path)] <> '\' then
  97.                   uses_path := uses_path + '\';
  98.                 p := '';
  99.               end;
  100.         else
  101.           syntax_exit('Unrecognized option '+paramstr(i)+'.');
  102.         end;
  103.         p := copy(p,2,255);
  104.       end;
  105.     end;
  106.   end;
  107.   if unitname = '' then
  108.     syntax_exit('Unit name not specified.');
  109. end;
  110.  
  111. end.
  112.